perm filename INSANE.LSP[206,JMC] blob sn#260597 filedate 1977-01-31 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	(DE CYCLES (U) (MAPLIST (FUNCTION (LAMBDA (X) (APPEND X (UPTO U X)))) U))
C00005 ENDMK
CāŠ—;
(DE CYCLES (U) (MAPLIST (FUNCTION (LAMBDA (X) (APPEND X (UPTO U X)))) U))

(DE UPTO (U X) (COND ((EQ X U) NIL) (T (CONS (CAR U) (UPTO (CDR U) X)))))

(DE PRUP (U V) (COND ((NULL U) NIL) (T (CONS (CONS (CAR U) (CAR V))
	(PRUP (CDR U) (CDR V))))))

(DE LOSE (P) (ORLIS (FUNCTION (LAMBDA (U) (MEMBER (CAR U) (CDR U)))) P))

(DE TER (P) (EQUAL (LENGTH (CAR P)) 4))

(DE SUCCESSORS (P) (MAPCAR (FUNCTION (LAMBDA (X) (MAPCAR2 
	(FUNCTION (LAMBDA (Y Z) (CONS Z Y))) 
	P X))) (CAR (NTH PUZZ (ADD1 (LENGTH (CAR P)))))))

(DE SUMCAR (FN U) (COND ((NULL U) 0)
			(T (PLUS (FN (CAR U)) (SUMCAR FN (CDR U))))))


(SETQ PUZZ3 (APPEND
	(CYCLES @(2 3 4 5))
	(CYCLES @(2 5 4 3))
	(CYCLES @(1 2 6 4))
	(CYCLES @(1 4 6 2))
	(CYCLES @(1 3 6 5))
	(CYCLES @(1 5 6 3))
))

(SETQ PUZZ5 @((2 3 4 5) (1 2 6 4) (1 3 6 5)))

(SETQ PUZZ1 @(
(G B B W R G)
(G G B G W R)
(G W W R B R)
(G G R B W W)
))
	
(SETQ PUZZ2 (MAPCAR (FUNCTION (LAMBDA (X) (PRUP @(1 2 3 4 5 6) X))) PUZZ1))

(SETQ PUZZ4 (MAPCAR (FUNCTION (LAMBDA (S) (SUBLIS S PUZZ3))) PUZZ2))

(SETQ PUZZ6 (MAPCAR (FUNCTION (LAMBDA (S) (SUBLIS S PUZZ5))) PUZZ2))

(SETQ PUZZ7 (MAPCAR (FUNCTION (LAMBDA (Z)
		(MAPCAR (FUNCTION (LAMBDA (W)
			(SUMCAR (FUNCTION (LAMBDA (X)
				(COND ((EQ X @W) 1)
					((EQ X @R) 10)
					((EQ X @G) 100)
					((EQ X @B) 1000)
				)))
			W)))
		Z))) PUZZ6))


(SETQ PUZZ (CONS (LIST (CAR (NTH (CAR PUZZ4) 1))
(CAR (NTH (CAR PUZZ4) 11)) (CAR (NTH (CAR PUZZ4) 21)))
		(CDR PUZZ4)))

(SETQ P0 @(NIL NIL NIL NIL))